home *** CD-ROM | disk | FTP | other *** search
/ Aminet 25 / Aminet 25 (1998)(GTI - Schatztruhe)[!][Jun 1998].iso / Aminet / comm / cnet / cnet_pager.lha / doors / pager / PagerSysAvail < prev    next >
Encoding:
Text File  |  1998-03-15  |  7.2 KB  |  147 lines
  1. /**************************************************************************\
  2.         $VER: Pager SysOp Out Editor, v5.20 (15-Mar-98) by Dotoran!
  3. \**************************************************************************/
  4. options results;signal on SYNTAX;signal on ERROR;signal on IOERR
  5. a=sourceline(2);parse var a . ", "ver" ("vdate")" .;a=random(,,time("s"))
  6. tr=transmit;se=sendstring;gc=getchar;gu=getuser;gs=getscratch;mg=maygetchar
  7. a="rexxsupport.library";if ~show("l",a) then if ~addlib(a,0,-30) then exit
  8. a='rexxreqtools.library';if ~show('l',a) then if ~addlib(a,0,-30) then exit
  9. parse source . . fp .;df=left(fp,max(lastpos('/',fp),lastpos(':',fp)))
  10.  
  11. /* Modify to match your language. Also, rename the Out.??? files as needed */
  12.  
  13. dtex="Sunday Monday Tuesday Wednesday Thursday Friday Saturday"
  14.  
  15. call SETUP ; call SCREEN ; call READDATA
  16.  
  17. START:
  18.   se ""4+row";"word(cols,col)"Hcfo1>o0"
  19.   day=word(days,col);hour=row+((col//2=0)*12)
  20.   rea=hour.day.hour;if rea="" then rea=default
  21.   se "7Hcf"gen" ca"left(rea,67-(length(gen)+1))"cd74H"substr(" ú",avail.day.hour+1,1)
  22.   do until a~="NOCHAR" ; mg ; a=upper(result) ; end ; call CHECK
  23.   if a=d2c(27) then do
  24.     do 2 ; mg ; k=result ; end
  25.     se ""4+row";"word(cols,col)"H "
  26.     if k="A" then do;row=row-1
  27.       if row<1 then do;row=12;col=col-1;if col<1 then col=14;end
  28.       signal START;end
  29.     if k="B" then do;row=row+1
  30.       if row>12 then do;row=1;col=col+1;if col>14 then col=1;end
  31.       signal START;end
  32.     if k="C" then do;col=col+1;if col>14 then col=1;signal START;end
  33.     if k="D" then do;col=col-1;if col<1 then col=14;signal START;end
  34.   end
  35.   if a=d2c(13) then do ; tog.day.hour=~(tog.day.hour)
  36.     av=substr("01",avail.day.hour+1,1)
  37.     tg=substr("05",tog.day.hour+1,1);co=max(av,tg)
  38.     se ""4+row";"word(cols,col)+1"Hz"co"c"substr("eb",(hour.day.hour>"")+1,1)
  39.     tr right(time.mode.hour,3)"z0"4+row";"word(cols,col)"H "
  40.     row=row+1;if row>12 then do;row=1;col=col+1;if col>14 then col=1;end
  41.     signal START
  42.   end
  43.  
  44.   if a=" " then do;reason=hour.day.hour;if reason="" then reason=default
  45.     tr clr;se "7Hc7Reasonc9: z0cer1L1305640 #"reason"}I260 60}r0"
  46.     gu 70;reason=result;save=1
  47.     se clr"7Hc7Apply to cf<caCcf>caurrentc7, cf<cbScf>cbelectedc7, or cf<cdDcf>cdefault c7hourcf(c7scf)c9: "
  48.     gc;a=result
  49.     if a="D" then do;tr "cdDefaultc7.";default=reason;signal START;end
  50.     if a="C" then do;tr "caCurrentc7.";hour.day.hour=reason
  51.       av=substr("01",avail.day.hour+1,1)
  52.       tg=substr("05",tog.day.hour+1,1);co=max(av,tg)
  53.       se ""4+row";"word(cols,col)+1"Hz"co"c"substr("eb",(hour.day.hour>"")+1,1)
  54.       tr right(time.mode.hour,3)"z0"
  55.       signal START;end
  56.     if a="S" then do;tr "cbSelectedc7."clr;se "7Hc7Processingc9: "
  57.       do i=1 to 7;do j=1 to 24
  58.       se left("ca"word(dtex,i)" cb@ c9"time.mode.j,15+3*3)"<f"
  59.       if tog.i.j=1 then hour.i.j=reason;end j;end i;tog.=0
  60.       tr "cbRedrawing c7time display...";call SCREEN2;signal START;end
  61.     tr "c9Abortc7.";signal START
  62.   end
  63.  
  64.   if a="Q" | (a=d2c(27) & k="NOCHAR") then do ; if save then call SAVEDATA
  65.     tr "f110Hc7Exiting cbCNet Pager ceSysAvail c7Editor!";exit;end
  66.   if a="/" then do;mode=~mode;call SCREEN2;signal START;end
  67.   if a="A" then do ; avail.day.hour=~(avail.day.hour)
  68.     av=substr("01",avail.day.hour+1,1);save=1
  69.     tg=substr("05",tog.day.hour+1,1);co=max(av,tg)
  70.     se ""4+row";"word(cols,col)+1"Hz"co"c"substr("eb",(hour.day.hour>"")+1,1)
  71.     tr right(time.mode.hour,3)"z0"4+row";"word(cols,col)"H "
  72.     row=row+1;if row>12 then do;row=1;col=col+1;if col>14 then col=1;end
  73.     signal START ; end
  74.  signal START
  75.  
  76. READDATA:
  77.   call open(f1,df"Availabilities","r")
  78.     do i=1 to 7;a=readln(f1)
  79.       call open(f2,df"Out."left(word(dtex,i),3),"r")
  80.         do j=1 to 24;hour.i.j=readln(f2);avail.i.j=substr(a,j,1);end j
  81.       call close(f2)
  82.     end i
  83.   call close(f1)
  84.   call open(f1,df"Out.Def","r");default=readln(f1);call close(f1)
  85.   if default="" then default="not available for chatting."
  86.   tr clr;se "7HcbDisplaying data..."
  87.  signal SCREEN2
  88.  
  89. SAVEDATA:
  90.   tr clr;se "7HcbSaving data..."
  91.   call open(f1,df"Availabilities","w")
  92.   do i=1 to 7;a=""
  93.     call open(f2,df"Out."left(word(dtex,i),3),"w")
  94.     do j=1 to 24
  95.       call writeln(f2,hour.i.j);a=a||avail.i.j
  96.     end j
  97.     call writeln(f1,a)
  98.     call close(f2)
  99.   end i
  100.   call close(f1)
  101.   call open(f1,df"Out.Def","w");call writeln(f1,default);call close(f1)
  102.   tr "hbed!"
  103.  return
  104.  
  105. SETUP:
  106.   time.="";hour.="";avail.=0;tog.=0;row=1;col=1;day=1;hour=1;clr="7H"copies(" ",68)
  107.   cols="6 10 16 20 26 30 36 40 46 50 56 60 66 70"
  108.   days="1 1 2 2 3 3 4 4 5 5 6 6 7 7";gu 1100461;gen=word("She's He's",result+1)
  109.   h12="12a 1a  2a  3a  4a  5a  6a  7a  8a  9a  10a 11a 12p 1p  2p  3p  4p  5p  6p  7p  8p  9p  10p 11p"
  110.   h24="000 010 020 030 040 050 060 070 080 090 100 110 120 130 140 150 160 170 180 190 200 210 220 230"
  111.   do i=1 to 24;time.1.i=word(h12,i);time.0.i=word(h24,i);end i;save=0
  112.   call open(f1,df"PagerConfigF","r")
  113.   a=readln(f1);parse var a j"|"j"|"j"|"j"|"mode"|"j;call close(f1)
  114.  return
  115.  
  116. SCREEN:
  117.   tr "f1@4"center("cbCNet Amiga Pagerc6, cf"ver" ceSysOp Out c6/ caAvailability cdEditorc6, cf"ver"c6!",79+10*3)
  118.   tr "cc    ÉÍÍÍÍÍÍÍÍÍËÍÍÍÍÍÍÍÍÍËÍÍÍÍÍÍÍÍÍËÍÍÍÍÍÍÍÍÍËÍÍÍÍÍÍÍÍÍËÍÍÍÍÍÍÍÍÍËÍÍÍÍÍÍÍÍÍ»" /* » */
  119.   tr "    ºz0car1   SUN   r0ccºz0car1   MON   r0ccºz0car1   TUE   r0ccºz0car1   WED   r0ccºz0car1   THU   r0ccºz0car1   FRI   r0ccºz0car1   SAT   r0ccº"
  120.   tr "    ÌÍÍÍÍÍÍÍÍÍÎÍÍÍÍÍÍÍÍÍÎÍÍÍÍÍÍÍÍÍÎÍÍÍÍÍÍÍÍÍÎÍÍÍÍÍÍÍÍÍÎÍÍÍÍÍÍÍÍÍÎÍÍÍÍÍÍÍÍ͹" /* ¹ */
  121.   do 12 ; tr "    ºCºCºCºCºCºCºCº" ; end
  122.   tr "    ÌÍÍÍÍÍÍÍÍÍÊÍÍÍÍÍÍÍÍÍÊÍÍÍÍÍÍÍÍÍÊÍÍÍÍÍÍÍÍÍÊÍÍÍÍÍÍÍÍÍÊÍÍÍÍÍÍÍÍÍÊÍÍÍÍÍÍÍÍ͹"
  123.   tr "    º cbReading data...ccCº"
  124.   tr "    ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ"
  125.   tr "    cfArrows c7move the o1cf>o0c7, cdENTER c7will z5ceSelect Hoursz0c7, caSPACE c7will define caReasonsc7."
  126.   tr "    Times in ceCYAN c7use ceDefault c7reason, while those in cbYELLOW c7are cbCustomizedc7."
  127.   tr "    Press `z0car1 / r0c7'(cfslashc7) to toggle cf12c7/cf24 time displayc7, press `z1cb A z0c7' to enable"
  128.   tr "    z1cbGlobal SysOp Availabilityz0 c7status, and press cdESC c7to cfSave c7& cdQuit c7editing!"
  129.  return
  130. SCREEN2:
  131.   do i=1 to 7;do j=1 to 12
  132.     se ""4+j";"i*10-3"Hz"substr("05",tog.i.j+1,1)"z"substr("01",avail.i.j+1,1)"c"substr("eb",(hour.i.j>"")+1,1)right(time.mode.j,3)"z0" ; jj=j+12
  133.     se ""4+j";"4+i*10-3"Hz"substr("05",tog.i.jj+1,1)"z"substr("01",avail.i.jj+1,1)"c"substr("eb",(hour.i.jj>"")+1,1)right(time.mode.jj,3)"z0"
  134.   end j;end i
  135.  return
  136.  
  137. CHECK:;if ARG() & ARG(1)~="###PANIC" then return ARG(1)
  138.   getcarrier;if result="TRUE" then if ARG() then return ARG(1);else return
  139.   logentry "Lost Carrier!!";bufferflush;exit
  140. SYNTAX:;ERROR:;IOERR:;e1="n1 Error: "rc" ("errortext(rc)")"
  141.   e2="  Line: "left(sigl,4)"File:";c="`"fp", "ver"'";e2=e2" "c;tr e1;tr e2
  142.   logentry e1;logentry e2;e=strip(translate(sourceline(sigl),"\{",""))
  143.   do while e~="";e3="Source: "left(e,37);tr e3;logentry e3;e=substr(e,38);end
  144.   bufferflush
  145. /**************************************************************************\
  146. \****************************************** Frontiers BBS (716)/823-9892 **/
  147.